home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbsub10.arc / WINDOW.SUB < prev   
Text File  |  1986-06-25  |  8KB  |  284 lines
  1. 'WINDOW.SUB -- MSDOS QuickBASIC Window handling subroutines    25 June 86
  2. '|         by David L. Poskie     (608) 274-9560
  3. '|                   7118 Raymond Rd. Madison, WI 53719
  4. '| These window-related subroutines were adapted from:
  5. '|     'Software Construction Set for the IBM PC and PCjr', by Eric Anderson,
  6. '|      Hayden Book Company, 1984.
  7. '|  Please run any suggestions, corrections, additions, or changes by me.
  8. '|  I can be messaged on all the major Madison, WI RBBS's.
  9.  
  10. '|  >>>> These routines do NOT save the underlying screen attributes when a
  11. '|       screen is saved. I'd appreciate a good modification to the Save &
  12. '|       Restore subroutines that would save attributes, and PEEK/POKE 
  13. '|       directly to video RAM (&HB800 for color). Another good modification
  14. '|      would be a set of SCROLL subroutines to use in windows.
  15.  
  16. '| NOTE: You must have $Include: 'KEY.SUB' in your main program, and you must
  17. '|        have DIMensioned variables there or uncommented the next two DIM's.
  18. '| >>>> These subroutines convert conventional Microsoft X = Row , Y = Column. 
  19. '|      In here, X is the horizontal dimension and Y is the vertical.
  20.  
  21.     ' For clarity, I prefer moving these to the top of the main program.
  22.     'DIM HSelect$(10) , VSelect$(10) , SaveWindow$(100)
  23.     'DIM NowX(20) , NowY(20) , NowWidth(20) , HeightNow(20)
  24.  
  25.     ' Set a base count for the save/restore subroutines
  26.     NumLines = 1
  27.  
  28.     '| Add window at (X , Y) of WWidth and WHeight
  29. AddWindow: 
  30.     ' Add 2 chars for border
  31.     WWidth = WWidth + 2
  32.     WHeight = WHeight + 2
  33.  
  34.     ' Bump NowWindow   ( NOW generally refers to the current window )
  35.     NowWindow = NowWindow + 1
  36.  
  37.     ' Transfer X , Y to NowX , NowY
  38.     NowX(NowWindow) = X
  39.     NowY(NowWindow) = Y
  40.  
  41.     ' Transfer width and height information
  42.     NowWidth(NowWindow) = WWidth
  43.     HeightNow(NowWindow) = WHeight
  44.  
  45.     '| Save underlying information in window
  46.     '|   at (X , Y) of WWidth and WHeight
  47. SaveWindow:
  48.     FOR W.Y = Y TO Y + WHeight - 1
  49.         SaveWindow$(NumLines) = ""
  50.  
  51.         ' Copy each character to SaveWindow$() (Doesn't get attribute)
  52.         FOR W.X = X TO X + WWidth - 1
  53.         SaveWindow$(NumLines) = SaveWindow$(NumLines) + CHR$(SCREEN(W.Y , W.X))
  54.         NEXT W.X
  55.  
  56.         NumLines = NumLines + 1
  57.     NEXT W.Y
  58.  
  59.     '| Draw window at (X , Y) of WWidth and WHeight
  60.     '| If DoubleBox = TRUE, do a double-line box else do a single-line box
  61. W.DRAW: 
  62.     LOCATE Y , X
  63.  
  64.     IF DoubleBox                            _
  65.        THEN PRINT CHR$(201); STRING$(WWidth - 2 , 205); CHR$(187);    _
  66.        ELSE PRINT CHR$(218); STRING$(WWidth - 2 , 196); CHR$(191);
  67.  
  68.     FOR W.Y = Y + 1 TO Y + WHeight - 2
  69.     LOCATE W.Y , X
  70.  
  71.     IF DoubleBox                            _
  72.        THEN PRINT CHR$(186); SPC(WWidth - 2); CHR$(186);        _
  73.        ELSE PRINT CHR$(179); SPC(WWidth - 2); CHR$(179);
  74.  
  75.     NEXT W.Y
  76.     LOCATE Y + WHeight - 1 , X
  77.  
  78.     IF DoubleBox                            _
  79.        THEN PRINT CHR$(200); STRING$(WWidth - 2 , 205); CHR$(188);    _
  80.        ELSE PRINT CHR$(192); STRING$(WWidth - 2 , 196); CHR$(217);
  81. RETURN
  82.  
  83.     '| Remove window
  84. KillWindow: 
  85.     X = NowX(NowWindow)        ' Let (X , Y) equal upper left
  86.     Y = NowY(NowWindow)        '  of window to remove
  87.     WWidth = NowWidth(NowWindow)    ' Window's width
  88.     WHeight = HeightNow(NowWindow)    ' Window's height
  89.     NowWindow = NowWindow - 1    ' One less window now
  90.     GOSUB RestoreWindow        ' Restore the text
  91. RETURN
  92.  
  93.     '| Restore text
  94. RestoreWindow: 
  95.     FOR W.Y = Y + WHeight - 1 TO Y STEP -1
  96.         LOCATE W.Y , X
  97.         NumLines = NumLines - 1
  98.  
  99.         ' If no window, restore original screen attributes,
  100.         '   else use screen attributes of window
  101.         IF NowWindow = 0                        _
  102.            THEN COLOR OldFG , OldBG , OldMG                _
  103.            ELSE COLOR FG,BG,MG
  104.  
  105.         PRINT SaveWindow$(NumLines)
  106.     NEXT W.Y
  107. RETURN
  108.  
  109.     '| Write Text$ at relative (X , Y) within window W
  110. WriteWindow: 
  111.     IF LEN(Text$) > (NowWidth(W) - 2) - X + 1            _
  112.        THEN Check = (NowWidth(W) - 2) - X + 1            _
  113.        ELSE Check = LEN(Text$)
  114.  
  115.     LOCATE NowY(W) + Y , NowX(W) + X
  116.     PRINT LEFT$(Text$ , Check);            ' If too big to fit
  117. RETURN                            ' truncate the text
  118.  
  119.     '| Write inverse Text$ at relative (X,Y) within window W
  120. WriteInverseWindow: 
  121.     IF LEN(Text$) > (NowWidth(W) - 2) - X + 1            _
  122.        THEN Check = (NowWidth(W) - 2) - X + 1            _
  123.        ELSE Check = LEN(Text$)
  124.  
  125.     LOCATE NowY(W) + Y , NowX(W) + X
  126.     COLOR 14 , 2 , MG
  127.     PRINT LEFT$(Text$ , Check);
  128.     COLOR 10 , 0 , MG
  129. RETURN
  130.  
  131.     '| Go to X , Y within the window, W
  132. WGoToXY:
  133.     LOCATE NowY(W) + Y , NowX(W) + X
  134. RETURN    
  135.                 ' This is the end of the window subroutines.
  136.                   ' Next come the window menu subroutines.
  137.  
  138.     '| Horizontal menu selection
  139.     '| Inputs to this routine
  140.     '| W               Which window to display the menu within
  141.     '| HSelect$()        The text of each menu selection
  142.     '| HNumSelects      How many selections are in the menu
  143.     '| HSelectWidth     How many columns each menu item gets
  144.     '| NewWindow           If TRUE, create the window, else
  145.     '|                   use the window specified by W
  146.     '| Returns:
  147.     '| SelectNum         The # of menu selection chosen.
  148.  
  149.     '| Set the parameters to create a 1 line window for the menu.
  150. HMenu: 
  151.     X = NowX(W)
  152.     Y = NowY(W)
  153.     WWidth = NowWidth(W) - 2
  154.     WHeight = 1
  155.  
  156.     IF NewWindow                            _
  157.        THEN GOSUB AddWindow :                    _
  158.         W = NowWindow
  159.  
  160.     X = 1 
  161.     Y = 1
  162.  
  163.     ' Clear out the current line
  164.     Text$ = SPACE$(WWidth)
  165.     GOSUB WriteWindow
  166.  
  167.     ' Now display the selections
  168.     FOR W.Y = 1 TO HNumSelects
  169.         Text$ = HSelect$(W.Y)
  170.         COLOR 10 , 0 , 8
  171.         GOSUB WriteWindow
  172.         X = X + HSelectWidth
  173.     NEXT W.Y
  174.     X = 1 
  175.     SelectNum = 1
  176.  
  177. DisplayHMenu: 
  178.     Text$ = HSelect$(SelectNum)
  179.     GOSUB WriteInverseWindow
  180.  
  181. HMenuGetKey: 
  182.     GOSUB GetKeyCode                           ' Get an input character
  183.  
  184.     ' Return if <CR> pressed
  185.     IF KeyCode = 13                            _
  186.        THEN RETURN
  187.  
  188.     ' If not left or right, get another
  189.     IF KeyCode <> 75                        _
  190.        AND KeyCode <> 77                        _
  191.            THEN GOTO HMenuGetKey
  192.  
  193.     ' Change current selection back to normal display
  194.     Text$ = HSelect$(SelectNum)
  195.     GOSUB WriteWindow
  196.  
  197.     '| If left arrow and at far left, wrap around & go.
  198.     IF KeyCode = 75                            _
  199.        AND SelectNum = 1                        _
  200.            THEN X = X + (HSelectWidth * (HNumSelects - 1)) :    _
  201.             SelectNum = HNumSelects :                 _
  202.             GOTO DisplayHMenu
  203.  
  204.     '| If left arrow, then move to previous menu selection
  205.     IF KeyCode = 75                            _
  206.        AND SelectNum > 1                        _
  207.            THEN X = X - HSelectWidth :                _
  208.             SelectNum = SelectNum - 1
  209.  
  210.     '| If right arrow and at far right, wrap around & go.
  211.     IF KeyCode = 77                            _
  212.        AND SelectNum = HNumSelects                    _
  213.            THEN X = X - (HSelectWidth * (HNumSelects - 1)) :    _
  214.             SelectNum = 1 :                    _
  215.             GOTO DisplayHMenu
  216.  
  217.     '| If right arrow then move to next menu selection
  218.     IF KeyCode = 77                            _
  219.        AND SelectNum < HNumSelects                    _
  220.            THEN X = X + HSelectWidth :                _
  221.             SelectNum = SelectNum + 1
  222. GOTO DisplayHMenu
  223.  
  224.     '| Vertical pull-down menu subroutine
  225.     '| Input: 
  226.     '| W               The # of the window holding the horizontal menu
  227.     '| SelectNum         The item selected on the horizontal menu
  228.     '| HSelectWidth     The # of columns for each item in that menu
  229.     '| VSelect$()        A list of each menu item to appear
  230.     '| VNumSelects      The # of selections in the pull down menu
  231.     '| VSelectWidth     How wide the pull-down menu should be
  232.     '| Returns:  
  233.     '| SelectNum         The # of the chosen menu selection
  234.  
  235.     '| Display one line window for menu
  236. VMenu: 
  237.     Y = NowY(W) + 2
  238.     X = NowX(W) + (SelectNum - 1) *  HSelectWidth
  239.     WWidth = VSelectWidth
  240.     WHeight = VNumSelects
  241.  
  242.          ' Draw the tiny window
  243.     GOSUB AddWindow
  244.     X = 1 
  245.     Y = 1 
  246.     W = NowWindow
  247.     FOR W.Y = 1 TO VNumSelects
  248.         Text$ = VSelect$(W.Y)
  249.         GOSUB WriteWindow
  250.         Y = Y + 1
  251.     NEXT W.Y
  252.     X = 1 
  253.     Y = 1 
  254.     SelectNum = 1
  255.  
  256. ShowVMenu: 
  257.     Text$ = VSelect$(SelectNum)
  258.     GOSUB WriteInverseWindow
  259.  
  260. VMenuGetKey: 
  261.     GOSUB GetKeyCode
  262.  
  263.     IF KeyCode = 13                            _
  264.        THEN RETURN
  265.  
  266.     IF KeyCode <> 72                        _
  267.        AND KeyCode <> 80                        _
  268.            THEN GOTO VMenuGetKey
  269.  
  270.     Text$ = VSelect$(SelectNum)
  271.     GOSUB WriteWindow
  272.  
  273.     IF KeyCode = 72                            _
  274.        AND SelectNum > 1                        _
  275.            THEN Y = Y - 1 :                        _
  276.             SelectNum = SelectNum - 1
  277.  
  278.     IF KeyCode = 80                            _
  279.        AND SelectNum < VNumSelects                    _
  280.            THEN Y = Y + 1 :                        _
  281.             SelectNum = SelectNum + 1
  282. GOTO ShowVMenu
  283. '|  >>>>> Physical EOF WINDOW.SUB  25 June 86
  284.